Directories

setwd("C:/Users/danie/OneDrive/Hertie Spring 20/R Geospatial Data")
library(tidyverse)
library(reshape2)
library(tmap)
library(raster)
library(RColorBrewer)
library(classInt)
library(viridisLite)
library(sp)
library(ggmap)
library(sf)
library(rgdal)

Chapter 4: Manipulating SF and Raster Data

library(lubridate)
df<-read.csv("Emergency_Response_Incidents.csv")
df_s_all<-df[complete.cases(df),] # Obtaining only complete cases
df_s<-df_s_all[,]
str(df_s)
'data.frame':   7797 obs. of  7 variables:
 $ Incident.Type: Factor w/ 443 levels "Administration-1 PP Activation",..: 430 308 14 430 32 430 32 33 269 407 ...
 $ Location     : Factor w/ 6193 levels "","01 Penn Plaza",..: 831 4853 5835 1621 2105 4530 2133 3952 3863 5593 ...
 $ Borough      : Factor w/ 62 levels "Astoria","Bergen",..: 46 28 46 46 28 28 28 37 28 59 ...
 $ Creation.Date: Factor w/ 7101 levels "01/01/2013 06:45:29 AM",..: 347 5803 6108 6485 6349 6499 6729 6449 6401 6417 ...
 $ Closed.Date  : Factor w/ 7100 levels "","01/01/2012 06:05:00 AM",..: 1 1 1 1 1 1 1 6418 1 1 ...
 $ Latitude     : num  40.7 40.7 40.7 40.7 40.7 ...
 $ Longitude    : num  -73.8 -74 -73.8 -73.8 -74 ...

Getting Geospatial Map of NYC

Note: GMap from Google Static Maps API; New York City borough shapefile from: https://data.cityofnewyork.us/City-Government/Borough-Boundaries/tqmj-j8zm

### Map file of NYCwith preset key from Google API ###
#Note: OSM is not available
map_nyc <- get_map(location = c(lon=df_s$Longitude[100],lat = df_s$Latitude[100]), zoom = 10)
Source : https://maps.googleapis.com/maps/api/staticmap?center=40.714422,-74.006076&zoom=10&size=640x640&scale=2&maptype=terrain&language=en-EN&key=xxx
### NYC Neighbourhood Data
shp_nyc_NTA<- st_read("geo_export_e52111a7-ba1f-48e5-876d-c912e4640c4b.shp")
Reading layer `geo_export_e52111a7-ba1f-48e5-876d-c912e4640c4b' from data source `C:\Users\danie\OneDrive\Hertie Spring 20\R Geospatial Data\geo_export_e52111a7-ba1f-48e5-876d-c912e4640c4b.shp' using driver `ESRI Shapefile'
Simple feature collection with 195 features and 7 fields
geometry type:  MULTIPOLYGON
dimension:      XY
bbox:           xmin: -74.25559 ymin: 40.49612 xmax: -73.70001 ymax: 40.91553
epsg (SRID):    4326
proj4string:    +proj=longlat +ellps=WGS84 +no_defs
#summary(shp_nyc_bor)

### NYC Boroughs Shapefile
shp_nyc_bor<-st_read("geo_export_5912ccc8-6f97-4ae2-bf31-ce6d35ef2fb4.shp")
Reading layer `geo_export_5912ccc8-6f97-4ae2-bf31-ce6d35ef2fb4' from data source `C:\Users\danie\OneDrive\Hertie Spring 20\R Geospatial Data\geo_export_5912ccc8-6f97-4ae2-bf31-ce6d35ef2fb4.shp' using driver `ESRI Shapefile'
Simple feature collection with 5 features and 4 fields
geometry type:  MULTIPOLYGON
dimension:      XY
bbox:           xmin: -74.25559 ymin: 40.49612 xmax: -73.70001 ymax: 40.91553
epsg (SRID):    4326
proj4string:    +proj=longlat +ellps=WGS84 +no_defs
### Confirming projection system of shapefile; default GMaps CRS is WGS84 ###
st_crs(shp_nyc_bor)
Coordinate Reference System:
  EPSG: 4326 
  proj4string: "+proj=longlat +ellps=WGS84 +no_defs"
st_crs(shp_nyc_NTA)
Coordinate Reference System:
  EPSG: 4326 
  proj4string: "+proj=longlat +ellps=WGS84 +no_defs"
### Creating SF file for database
emr_nyc<-st_as_sf(df_s,coords=c("Longitude","Latitude"))

### Checks for consistent CRS
st_crs(emr_nyc)
Coordinate Reference System: NA
st_crs(emr_nyc)<-st_crs(shp_nyc_NTA)
st_crs(shp_nyc_NTA)==st_crs(emr_nyc)
[1] TRUE
### Initial Plot
plot(st_geometry(shp_nyc_NTA))
plot(emr_nyc, add = TRUE, col = "yellow")
ignoring all but the first attribute

Borough Level Data Analysis

The plot below shows the density of emergency response incidents per 1 million sq km. I begin by using the function \(st_intersects()\) and then plot based on each borough. Of the five boroughs, Manhattan has the highest incident density rate, which is not surprising. However, It seems like Manhattan’s high rate has eclipsed that of the other boroughs. We can change this by specifying the breaks in the data visualized.

### Calculating Statistics for Borough-Level
count   <- st_intersects(shp_nyc_bor,emr_nyc)
although coordinates are longitude/latitude, st_intersects assumes that they are planar
#Counting number of occurences
n_bor   <-lengths(count) 
#Calculating Areas
area_bor<-unclass(st_area(shp_nyc_bor))
#Calculating Density
den_bor <-n_bor/area_bor

comb_bor <- shp_nyc_bor %>%
  mutate(n = n_bor, den = den_bor, area = area_bor, den1mil = den_bor*1e6)
head(shp_nyc_NTA)
Simple feature collection with 6 features and 7 fields
geometry type:  MULTIPOLYGON
dimension:      XY
bbox:           xmin: -74.00736 ymin: 40.58731 xmax: -73.75047 ymax: 40.8236
epsg (SRID):    4326
proj4string:    +proj=longlat +ellps=WGS84 +no_defs
  boro_code boro_name county_fip ntacode        ntaname shape_area shape_leng
1         3  Brooklyn        047    BK88   Borough Park   54005019   39247.23
2         4    Queens        081    QN51    Murray Hill   52488278   33266.90
3         4    Queens        081    QN27  East Elmhurst   19726846   19816.71
4         4    Queens        081    QN07         Hollis   22887773   20976.34
5         1 Manhattan        061    MN06 Manhattanville   10647078   17040.69
6         3  Brooklyn        047    BK25      Homecrest   29991967   27514.02
                        geometry
1 MULTIPOLYGON (((-73.97605 4...
2 MULTIPOLYGON (((-73.80379 4...
3 MULTIPOLYGON (((-73.8611 40...
4 MULTIPOLYGON (((-73.75726 4...
5 MULTIPOLYGON (((-73.94608 4...
6 MULTIPOLYGON (((-73.95859 4...
### Plotting
maps_bor<- mapview(shp_nyc_NTA,zcol ="ntaname", 
          layer.name = "New York Neighborhoods", 
          lwd = 1,
          color = "black",
          alpha.regions = 0, hide = TRUE,legend=FALSE)+
  mapview(comb_bor, zcol = "den1mil", 
          col.regions = sf.colors(10), 
          alpha.regions = 0.8, 
          layer.name = "Incidents per 1 million sq km",
          at = c(2,5,10,3060))
maps_bor

NA
NA

NTA Level Data Mapping

This map is more useful as we can see finer detail abotu the relative number of incidents, controlling for the area of neighborhoods. Below, we observe that SoHo-TriBeCa-Civic Center-Little Italy has the highest number of incidents. Interestingly, we also see that Kew Gardens in Queens has an unusually high emergency incident rate vis-a-vis other neighborhoods in its surroundings and in Queens.

### Finding out density of incidents per neighborhood
count   <- st_intersects(shp_nyc_NTA,emr_nyc)
although coordinates are longitude/latitude, st_intersects assumes that they are planar
#Counting number of occurences
n_res   <-lengths(count) 
#Calculating Areas
area_NTA<-unclass(st_area(shp_nyc_NTA))
#Calculating Density
den_NTA <-n_res/area_NTA

comb_NTA <- shp_nyc_NTA %>%
  mutate(n = n_res, den = den_NTA, area = area_NTA, den1mil = den_NTA*1e6)


### Plotting
# Statistical Viewing
ggplot(comb_NTA)+
  geom_histogram(aes(x = n))

ggplot(comb_NTA, aes(x = n, y = area))+
  geom_point()+
  stat_smooth()

# Using Map View
library(mapview)
maps_NTA<- mapview(shp_nyc_bor,zcol ="boro_name", 
          layer.name = "New York Boroughs", 
          lwd = 5,
          color = "black",
          alpha.regions = 0)+
  mapview(comb_NTA, zcol = "den1mil", 
          col.regions = sf.colors(10), 
          alpha.regions = 0.8, 
          layer.name = "Incidents per 1 million sq km",
          at = seq(0,200,20))

maps_NTA

Using Thematic Maps

# Using Thematic Maps
yellowred<-brewer.pal(n=5,"YlOrRd")
tmap_mode("view")
tmap mode set to interactive viewing
tm_NTA<-tm_shape(comb_NTA)+
  tm_borders()+
  tm_fill(col = "n", title = "Number of Incidents", 
          palette = yellowred, style = "quantile",
          alpha = 0.6)+
  tm_shape(shp_nyc_bor)+
  tm_borders(col = "grey60",lwd = 2)+
  tm_basemap
tm_NTA

tmap_save(filename = "tm_NTA.html")
Interactive map saved to C:\Users\danie\OneDrive\Hertie Spring 20\R Geospatial Data\tm_NTA.html
LS0tDQp0aXRsZTogIkdlb3NwYXRpYWwgRGF0YSB3aXRoIFIgUGFydCAzIC0gU0YgYW5kIFJhc3RlciBPYmplY3RzIg0KYXV0aG9yOiAiRGFuaWVsIEthaSBTaGVuZyBCb2V5Ig0KZGF0ZTogIjNyZCBNYXJjaCAyMDE5Ig0Kb3V0cHV0OiANCiAgaHRtbF9ub3RlYm9vazoNCiAgICB0b2M6IHRydWUNCi0tLQ0KDQojIyBEaXJlY3Rvcmllcw0KYGBge3J9DQpzZXR3ZCgiQzovVXNlcnMvZGFuaWUvT25lRHJpdmUvSGVydGllIFNwcmluZyAyMC9SIEdlb3NwYXRpYWwgRGF0YSIpDQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCmxpYnJhcnkocmVzaGFwZTIpDQpsaWJyYXJ5KHRtYXApDQpsaWJyYXJ5KHJhc3RlcikNCmxpYnJhcnkoUkNvbG9yQnJld2VyKQ0KbGlicmFyeShjbGFzc0ludCkNCmxpYnJhcnkodmlyaWRpc0xpdGUpDQpsaWJyYXJ5KHNwKQ0KbGlicmFyeShnZ21hcCkNCmxpYnJhcnkoc2YpDQpsaWJyYXJ5KHJnZGFsKQ0KYGBgDQoNCg0KIyBDaGFwdGVyIDQ6IE1hbmlwdWxhdGluZyBTRiBhbmQgUmFzdGVyIERhdGENCg0KDQpgYGB7cn0NCmxpYnJhcnkobHVicmlkYXRlKQ0KZGY8LXJlYWQuY3N2KCJFbWVyZ2VuY3lfUmVzcG9uc2VfSW5jaWRlbnRzLmNzdiIpDQpkZl9zX2FsbDwtZGZbY29tcGxldGUuY2FzZXMoZGYpLF0gIyBPYnRhaW5pbmcgb25seSBjb21wbGV0ZSBjYXNlcw0KZGZfczwtZGZfc19hbGxbLF0NCnN0cihkZl9zKQ0KYGBgDQojIyBHZXR0aW5nIEdlb3NwYXRpYWwgTWFwIG9mIE5ZQw0KTm90ZTogR01hcCBmcm9tIEdvb2dsZSBTdGF0aWMgTWFwcyBBUEk7IE5ldyBZb3JrIENpdHkgYm9yb3VnaCBzaGFwZWZpbGUgZnJvbTogaHR0cHM6Ly9kYXRhLmNpdHlvZm5ld3lvcmsudXMvQ2l0eS1Hb3Zlcm5tZW50L0Jvcm91Z2gtQm91bmRhcmllcy90cW1qLWo4em0NCg0KYGBge3J9DQojIyMgTWFwIGZpbGUgb2YgTllDd2l0aCBwcmVzZXQga2V5IGZyb20gR29vZ2xlIEFQSSAjIyMNCiNOb3RlOiBPU00gaXMgbm90IGF2YWlsYWJsZQ0KbWFwX255YyA8LSBnZXRfbWFwKGxvY2F0aW9uID0gYyhsb249ZGZfcyRMb25naXR1ZGVbMTAwXSxsYXQgPSBkZl9zJExhdGl0dWRlWzEwMF0pLCB6b29tID0gMTApDQoNCiMjIyBOWUMgTmVpZ2hib3VyaG9vZCBEYXRhDQpzaHBfbnljX05UQTwtIHN0X3JlYWQoImdlb19leHBvcnRfZTUyMTExYTctYmExZi00OGU1LTg3NmQtYzkxMmU0NjQwYzRiLnNocCIpDQojc3VtbWFyeShzaHBfbnljX2JvcikNCg0KIyMjIE5ZQyBCb3JvdWdocyBTaGFwZWZpbGUNCnNocF9ueWNfYm9yPC1zdF9yZWFkKCJnZW9fZXhwb3J0XzU5MTJjY2M4LTZmOTctNGFlMi1iZjMxLWNlNmQzNWVmMmZiNC5zaHAiKQ0KDQojIyMgQ29uZmlybWluZyBwcm9qZWN0aW9uIHN5c3RlbSBvZiBzaGFwZWZpbGU7IGRlZmF1bHQgR01hcHMgQ1JTIGlzIFdHUzg0ICMjIw0Kc3RfY3JzKHNocF9ueWNfYm9yKQ0Kc3RfY3JzKHNocF9ueWNfTlRBKQ0KDQojIyMgQ3JlYXRpbmcgU0YgZmlsZSBmb3IgZGF0YWJhc2UNCmVtcl9ueWM8LXN0X2FzX3NmKGRmX3MsY29vcmRzPWMoIkxvbmdpdHVkZSIsIkxhdGl0dWRlIikpDQoNCiMjIyBDaGVja3MgZm9yIGNvbnNpc3RlbnQgQ1JTDQpzdF9jcnMoZW1yX255YykNCnN0X2NycyhlbXJfbnljKTwtc3RfY3JzKHNocF9ueWNfTlRBKQ0Kc3RfY3JzKHNocF9ueWNfTlRBKT09c3RfY3JzKGVtcl9ueWMpDQoNCiMjIyBJbml0aWFsIFBsb3QNCnBsb3Qoc3RfZ2VvbWV0cnkoc2hwX255Y19OVEEpKQ0KcGxvdChlbXJfbnljLCBhZGQgPSBUUlVFLCBjb2wgPSAieWVsbG93IikNCg0KDQoNCmBgYA0KDQojIyBCb3JvdWdoIExldmVsIERhdGEgQW5hbHlzaXMNClRoZSBwbG90IGJlbG93IHNob3dzIHRoZSBkZW5zaXR5IG9mIGVtZXJnZW5jeSByZXNwb25zZSBpbmNpZGVudHMgcGVyIDEgbWlsbGlvbiBzcSBrbS4gSSBiZWdpbiBieSB1c2luZyB0aGUgZnVuY3Rpb24gJHN0X2ludGVyc2VjdHMoKSQgYW5kIHRoZW4gcGxvdCBiYXNlZCBvbiBlYWNoIGJvcm91Z2guIE9mIHRoZSBmaXZlIGJvcm91Z2hzLCBNYW5oYXR0YW4gaGFzIHRoZSBoaWdoZXN0IGluY2lkZW50IGRlbnNpdHkgcmF0ZSwgd2hpY2ggaXMgbm90IHN1cnByaXNpbmcuIEhvd2V2ZXIsIEl0IHNlZW1zIGxpa2UgTWFuaGF0dGFuJ3MgaGlnaCByYXRlIGhhcyBlY2xpcHNlZCB0aGF0IG9mIHRoZSBvdGhlciBib3JvdWdocy4gV2UgY2FuIGNoYW5nZSB0aGlzIGJ5IHNwZWNpZnlpbmcgdGhlIGJyZWFrcyBpbiB0aGUgZGF0YSB2aXN1YWxpemVkLiANCmBgYHtyfQ0KIyMjIENhbGN1bGF0aW5nIFN0YXRpc3RpY3MgZm9yIEJvcm91Z2gtTGV2ZWwNCmNvdW50ICAgPC0gc3RfaW50ZXJzZWN0cyhzaHBfbnljX2JvcixlbXJfbnljKQ0KI0NvdW50aW5nIG51bWJlciBvZiBvY2N1cmVuY2VzDQpuX2JvciAgIDwtbGVuZ3Rocyhjb3VudCkgDQojQ2FsY3VsYXRpbmcgQXJlYXMNCmFyZWFfYm9yPC11bmNsYXNzKHN0X2FyZWEoc2hwX255Y19ib3IpKQ0KI0NhbGN1bGF0aW5nIERlbnNpdHkNCmRlbl9ib3IgPC1uX2Jvci9hcmVhX2Jvcg0KDQpjb21iX2JvciA8LSBzaHBfbnljX2JvciAlPiUNCiAgbXV0YXRlKG4gPSBuX2JvciwgZGVuID0gZGVuX2JvciwgYXJlYSA9IGFyZWFfYm9yLCBkZW4xbWlsID0gZGVuX2JvcioxZTYpDQpoZWFkKHNocF9ueWNfTlRBKQ0KIyMjIFBsb3R0aW5nDQptYXBzX2JvcjwtIG1hcHZpZXcoc2hwX255Y19OVEEsemNvbCA9Im50YW5hbWUiLCANCiAgICAgICAgICBsYXllci5uYW1lID0gIk5ldyBZb3JrIE5laWdoYm9yaG9vZHMiLCANCiAgICAgICAgICBsd2QgPSAxLA0KICAgICAgICAgIGNvbG9yID0gImJsYWNrIiwNCiAgICAgICAgICBhbHBoYS5yZWdpb25zID0gMCwgaGlkZSA9IFRSVUUsbGVnZW5kPUZBTFNFKSsNCiAgbWFwdmlldyhjb21iX2JvciwgemNvbCA9ICJkZW4xbWlsIiwgDQogICAgICAgICAgY29sLnJlZ2lvbnMgPSBzZi5jb2xvcnMoMTApLCANCiAgICAgICAgICBhbHBoYS5yZWdpb25zID0gMC44LCANCiAgICAgICAgICBsYXllci5uYW1lID0gIkluY2lkZW50cyBwZXIgMSBtaWxsaW9uIHNxIGttIiwNCiAgICAgICAgICBhdCA9IGMoMiw1LDEwLDMwNjApKQ0KbWFwc19ib3INCg0KDQpgYGANCg0KDQojIyBOVEEgTGV2ZWwgRGF0YSBNYXBwaW5nDQpUaGlzIG1hcCBpcyBtb3JlIHVzZWZ1bCBhcyB3ZSBjYW4gc2VlIGZpbmVyIGRldGFpbCBhYm90dSB0aGUgcmVsYXRpdmUgbnVtYmVyIG9mIGluY2lkZW50cywgY29udHJvbGxpbmcgZm9yIHRoZSBhcmVhIG9mIG5laWdoYm9yaG9vZHMuIEJlbG93LCB3ZSBvYnNlcnZlIHRoYXQgU29Iby1UcmlCZUNhLUNpdmljIENlbnRlci1MaXR0bGUgSXRhbHkgaGFzIHRoZSBoaWdoZXN0IG51bWJlciBvZiBpbmNpZGVudHMuIEludGVyZXN0aW5nbHksIHdlIGFsc28gc2VlIHRoYXQgS2V3IEdhcmRlbnMgaW4gUXVlZW5zIGhhcyBhbiB1bnVzdWFsbHkgaGlnaCBlbWVyZ2VuY3kgaW5jaWRlbnQgcmF0ZSB2aXMtYS12aXMgb3RoZXIgbmVpZ2hib3Job29kcyBpbiBpdHMgc3Vycm91bmRpbmdzIGFuZCBpbiBRdWVlbnMuIA0KYGBge3J9DQojIyMgRmluZGluZyBvdXQgZGVuc2l0eSBvZiBpbmNpZGVudHMgcGVyIG5laWdoYm9yaG9vZA0KY291bnQgICA8LSBzdF9pbnRlcnNlY3RzKHNocF9ueWNfTlRBLGVtcl9ueWMpDQojQ291bnRpbmcgbnVtYmVyIG9mIG9jY3VyZW5jZXMNCm5fcmVzICAgPC1sZW5ndGhzKGNvdW50KSANCiNDYWxjdWxhdGluZyBBcmVhcw0KYXJlYV9OVEE8LXVuY2xhc3Moc3RfYXJlYShzaHBfbnljX05UQSkpDQojQ2FsY3VsYXRpbmcgRGVuc2l0eQ0KZGVuX05UQSA8LW5fcmVzL2FyZWFfTlRBDQoNCmNvbWJfTlRBIDwtIHNocF9ueWNfTlRBICU+JQ0KICBtdXRhdGUobiA9IG5fcmVzLCBkZW4gPSBkZW5fTlRBLCBhcmVhID0gYXJlYV9OVEEsIGRlbjFtaWwgPSBkZW5fTlRBKjFlNikNCg0KDQojIyMgUGxvdHRpbmcNCiMgU3RhdGlzdGljYWwgVmlld2luZw0KZ2dwbG90KGNvbWJfTlRBKSsNCiAgZ2VvbV9oaXN0b2dyYW0oYWVzKHggPSBuKSkNCmdncGxvdChjb21iX05UQSwgYWVzKHggPSBuLCB5ID0gYXJlYSkpKw0KICBnZW9tX3BvaW50KCkrDQogIHN0YXRfc21vb3RoKCkNCiMgVXNpbmcgTWFwIFZpZXcNCmxpYnJhcnkobWFwdmlldykNCm1hcHNfTlRBPC0gbWFwdmlldyhzaHBfbnljX2Jvcix6Y29sID0iYm9yb19uYW1lIiwgDQogICAgICAgICAgbGF5ZXIubmFtZSA9ICJOZXcgWW9yayBCb3JvdWdocyIsIA0KICAgICAgICAgIGx3ZCA9IDUsDQogICAgICAgICAgY29sb3IgPSAiYmxhY2siLA0KICAgICAgICAgIGFscGhhLnJlZ2lvbnMgPSAwKSsNCiAgbWFwdmlldyhjb21iX05UQSwgemNvbCA9ICJkZW4xbWlsIiwgDQogICAgICAgICAgY29sLnJlZ2lvbnMgPSBzZi5jb2xvcnMoMTApLCANCiAgICAgICAgICBhbHBoYS5yZWdpb25zID0gMC44LCANCiAgICAgICAgICBsYXllci5uYW1lID0gIkluY2lkZW50cyBwZXIgMSBtaWxsaW9uIHNxIGttIiwNCiAgICAgICAgICBhdCA9IHNlcSgwLDIwMCwyMCkpDQoNCm1hcHNfTlRBDQpgYGANCiMjIFVzaW5nIFRoZW1hdGljIE1hcHMNCmBgYHtyfQ0KIyBVc2luZyBUaGVtYXRpYyBNYXBzDQp5ZWxsb3dyZWQ8LWJyZXdlci5wYWwobj01LCJZbE9yUmQiKQ0KdG1hcF9tb2RlKCJ2aWV3IikNCnRtX05UQTwtdG1fc2hhcGUoY29tYl9OVEEpKw0KICB0bV9ib3JkZXJzKCkrDQogIHRtX2ZpbGwoY29sID0gIm4iLCB0aXRsZSA9ICJOdW1iZXIgb2YgSW5jaWRlbnRzIiwgDQogICAgICAgICAgcGFsZXR0ZSA9IHllbGxvd3JlZCwgc3R5bGUgPSAicXVhbnRpbGUiLA0KICAgICAgICAgIGFscGhhID0gMC42KSsNCiAgdG1fc2hhcGUoc2hwX255Y19ib3IpKw0KICB0bV9ib3JkZXJzKGNvbCA9ICJncmV5NjAiLGx3ZCA9IDIpKw0KICB0bV9iYXNlbWFwDQp0bV9OVEENCnRtYXBfc2F2ZShmaWxlbmFtZSA9ICJ0bV9OVEEuaHRtbCIpDQpgYGANCg0K